homepage6047　2018年 12月 [2024年 システム調整 対策済み]

プログラミングやRPG（作るほう）が好きな人の日記

2018/12/29（土）　年末年始休み　２日目／１０日

「オブジェクト指向は難しい…」[2024年 システム調整 対策済み]

そんなひとことを３０代くらいの若手プログラマーの人から聞いたことがあります。

N88-BASIC という言語を用いて、「オブジェクト指向のカプセル化の有無の違い」について見ていきましょう。

N88-BASICを用いるのには理由があります。

オブジェクト指向の良さが、どうもわからないという方は、BASICの時代のプログラミングを知らないからオブジェクト指向の良さがわからないんだと思います。N88-BASICで、オブジェクトどうしの区分けがなく、メソッドもない、そんな不便な世界を知っていれば、オブジェクト指向の良さがわかると思うんです。

……ただ、今回はアプローチがちょっと違っていて、なぜか、N88-BASICでオブジェクト指向と同じことをやろうとしています…

まぁ、見ていきましょうか。左のタブから順に見ていってください。

オブジェクト指向のカプセル化の有無の違い タブストリップ

このタブインターフェースは私が作成したものです。（紹介ページへ）

カプセル化はデータを提供する側とデータを利用する側との間にアクセサメソッドを用意することで、提供する側のデータの持ち方の変更の影響を 利用する側に見せないようにしている…ということなんだと思います。

カプセル化のためには、クラスという概念は必ずしも必要ではなく、提供する側と利用する側との間に何か１つ緩衝材（かんしょうざい）のようなしくみがあればいいんだと思います。（ただ世間ではクラスを使うことを前提としていることが多いので、必要と考えておいたほうが良いです）

そうすることで変更に強いプログラムになるわけですが、のちのちの修正の手間を見越して、あらかじめ回避しようという作業なので、ちょっと退屈に感じるかもしれません。その良さを実感するのは今ではなく、将来 仕様変更や修正をするときですから。保険とか国民年金とか払っても面白くないのと似ています。

カプセル化を行う動機：

「会社から言われてやってる」じゃ、つらいんじゃないかな？

• 外部からの予期しない干渉でオブジェクトの状態が壊れることを防ぐ堅牢なソフトウェアにしたい。（ここの言葉を使用しています）
• きちんとしたソフトウェアを作りたい。
• 将来変更する可能性があるから、そのときに苦労しないで済むようにしよう。
• お客さんのソフトウェアだから、変更に時間がかからないように。
• お客さんのソフトウェアだから、きちんとしたものを。

（なお、私はオブジェクト指向は数年前に本を読んで勉強してましたが、カプセル化等 ほとんど忘れている状態であって、今日思い立ってこの記事を書くにあたって当時の本を引っ張り出した、といった感じです）

余談１　勉強のしかた：

勉強の仕方ですが、前から見る方法だけでも勉強できますが、後ろから見る方法もおススメです。

オブジェクト指向の良さは、

1. 変更に強い
2. 再利用できる
3. 拡張性

の３本立て、ということですが（今本見ています）

今回話題にしたカプセル化は　変更に強い　ことに効果があるのであって、ほかの２つの　再利用　と、拡張性　については（書籍などをよく見てみると）特に言及されていない、という事実があります。（何かの本ではほかの２つにも効果があると言っているかもしれませんが、私の持っている本では特にそうは言っていないようです）

前から見るというのは「変更に強い、以上」という勉強の仕方であって、

後ろから見るというのは「変更に強い、また、再利用については無関係、拡張性についても無関係」とすみわけをはっきりさせるということです。

「カプセル化は再利用や拡張性に効果がある？」と聞かれて、「ないんじゃないか？」とはっきり答えられると良い、ということです。

余談２　N88-BASIC：

N88-BASICを久しぶりに使ったんですが、いろいろ発見がありました。

• N88-BASICは私が中高生のころによく使っていましたが、「ユーザー定義関数」というものはどこか難しげで使った記憶がありません。私のプログラミングはすべてGOSUBによるサブルーチンで事足りていたと思います。今回30年目にしてようやく「ユーザー定義関数」を使ったわけです。
  
  DEFFN文で関数を定義し、FN文で定義した関数を呼び出します。変わっているのが、関数名がアルファベット１文字だってことです。
  DEFFNA=1+1 は２を返すAという名前の関数です。呼び方は FNA と書きます。
  DEFFNB=FNA * 3 は関数Aを呼びつつ6を返すBという名前の関数です。呼び方はFNBです。
  そういうわけでアルファベットの数26個しか関数を定義できません。
  　
• 今回使用したN88-BASICのWindows版フリーウェアの「99BASIC」はWindows10ではそのままでは動きません。
  コントロールパネルから「デバイスとプリンター」を選び、プリンターの並んでいる列でプリンターのどれか１つを右クリックし「通常使うプリンターに設定」を選びます。するとその選んだプリンターの種類によって「99BASIC」の起動の可否がわかれるんです。それがわかるまでは９０％、使用をあきらめていました。

2018/12/28（金）　年末年始休み　１日目／１０日

このホームページの機能追加を図ったんですが、結局ダメでボツになってしまった。丸一日かけたのに…なんだったんだ…orz

（具体的に言うと、このホームページ上でExcelVBAと書いたら、自動的に「このホームページ上で ExcelVBA と書いたら」とアルファベットの単語の前後に半角スペースが入り読みやすくなる、という機能を作っていました。でもこのホームページ上のいろいろなリンクやスクリプトが動かなくなってしまったので、あきらめました）

---

---

---

古代祐三氏のMUCOM88を試してみました。

コンピューターゲームの音楽の作曲家である古代祐三氏によって1987年に開発された「MUCOM88」という音楽製作ツールが無償公開されました。

• 無償公開を報じたニュース　窓の杜（オンラインソフト紹介サイト）記事（2018/12/25）

PC-8801シリーズで動作するものと、Windowsで動作するものの２種類が公開されています。

そこで、私も Windows 版のほうをダウンロードして試してみました。

（リズム音源を別途ダウンロードしてMUCOM88 Windowsと同じフォルダに配置するなどサイトの説明のとおりに行います）

音を鳴らしてみる：

このサイトの説明のとおりに　A t190@30v15 cdefgab>c　というMML（音楽演奏言語）文字列を黒い画面に挿入して、画面の「PLAY」ボタンを押すと、すぐに音が鳴りました。Windowsだけど、ちゃんとYM2203/YM2608のFM音源（のエミュレート?）で鳴っているようです。

サンプル曲データを鳴らしてみる：

画面の「MENU」ボタンを押すとMMLファイルの管理画面（ホーム）になります。

提供サイトではPC-8801版とWindows版の両方でサンプルが用意されていますが、両方とも同じ内容のようです。

サンプルは過去に古代祐三氏が作曲し他社ゲームソフト内で使われた楽曲で、同氏に著作権があるそうです。

（※PC-8801版はサンプル１つ１つがディスクイメージファイルになっていたので、Windows版のサンプルをダウンロードしたほうが良いと思います）

サンプルのフォルダに移動（マウスではなくキーボードのEnterキーで移動）して、.muc形式のファイルを選んで、「再生」ボタンを押すと、iTunes storeでダウンロードした「アクトレイザー　フィルモア」と同じ曲が流れました。あの繊細な音源がMMLのレベルで手元にあるなんて、なんてありがたいことだろう。

サンプルはもちろん古代祐三氏の著作権がありますが、このツールでユーザーが作成した音楽は録音して自分のゲームに使うなりいろいろできると思うので、ほかのシーケンサーソフトを使わずにこちらを使わせていただく…なんてことができると思います。

あと、同氏は作曲家であると同時にプログラマーでもあるとは初めて知りました。FM音源のドライバソフトも自作していたということで、YM2203のICチップのデータシートみたいなものも読んでいた可能性もあるのでひょっとしたら電気関係もある程度ご存知かもしれない…。

2018/12/24（月）　３連休　最終日

[2024年 システム調整 対策済み]

先月の冒頭プログラムのグラディウスのマネですが、「まだ遊べないです☆彡」という状態だったのを少し遊べるようにしました。

「まだ遊べないです」と書いてそのままっていうのも残念な気がしたから。

下の画像をクリックすると１１月ページの冒頭へ移動し、ゲームが開始されます…が、コンピューターの性能を高く要求するかもしれません。

横長だとダライアス（画像検索）みたいだ。

フルスクリーン版もあります。これ　（F11キーを押してブラウザをフルスクリーンにすると楽しいかも。戻すには再度F11です）

またExcel画像の使いまくり。

音楽がなくて寂しいし、自分は死なないし、ステージは途中で終わってるしで、途中だけど。

グラディウスみたいなの作っていて、グラディウスのひとつのステージを作るのって まるで一枚のCGを描いているようだなって思いました。

１つ１つの敵キャラのふるまいを調整して、プレイヤーを楽しませる。ステージ全体を とおして調整していき、１つのステージを完成させる。

CGもそんな感じで描いている気がします。

参考にMicrosoft Storeの無料の「PCエンジン版グラディウス」をダウンロードして、見てみたんですが、すんげーゴージャスじゃないか。自分のと比べて。

やっぱりプロの仕事は違うな。ほか作品との競争であったり、プレイヤーが払ったお金に見合うできばえを求めたり、過去の経験を駆使したりといろいろな要素でゴージャスになっているんだな、と思いました。

このプログラムのリスト（リスト中のコメントはあまり信用しないでください）

//- 関数リスト - ..

// 1: app.init ..

// 2: app.onpreloadx ..

// 3: app.afterOnload ..

// 4: app.scheduleAdd ..

// 5: app.newEnemy ..

// 6: app.entrySprite ..

// 7: app.deleteSprite ..

// 8: app.run ..

// 9: app.addStar ..

// 10: app.drawTextCenter ..

// 11: app.draw ..

// 12: app.keyType ..

// 13: app.keySense ..

// 14: app.fire ..

// 15: ImagePalette ..

// 16: ImagePalette.prototype.drawImage ..

// 17: ImagePalette.prototype.drawImage_single ..

// 18: Sprite ..

// 19: Sprite.prototype.setWidth ..

// 20: Sprite.prototype.setHeight ..

// 21: Sprite.prototype.setWidthWithAspectHeight ..

// 22: Sprite.prototype.draw ..

// 23: Sprite.prototype.frame ..

// 24: Sprite.prototype.moveFunction ..

// 25: Sprite.prototype.animFrameChecker ..

// 26: Sprite.prototype.moveFrameChecker ..

// 27: Maps ..

// 28: Maps.prototype.ready ..

// 29: Maps.prototype.frame ..

// 30: Maps.prototype.draw ..

// 31: Map ..

console.log( "20181125-index.js loading.." );

//---今月のスクリプト

/*

this.canvasApply(200,200);　は何をしているのか？

this.canvasEL.style.width　を変更している

this.canvasEL.style.height　を変更している

this.pixelsize　を変更している

this.resetMozaic();　を実行している

以上

this.ready();　は何をしているか？

this.draw()　を実行

this.onscrollx()　を意図的実行

onscrollx()はcanvasが視聴者の目に入ったかどうかを見ている。

目に入ったら、this.start()、入らなくなったらthis.stop()を実行している。

scroll　のイベントリスナを設定

以上

コンストラクタAppはcanvasをどのように用意しているか？

function App( id, element ) {

引数のelementについてタグ名がCANVASなら、elementをthis.canvasELとする。

canvasではないなら、canvas自動生成を行う。

canvas自動生成は、elementを親としてcanvasを設置する。

（そのIDはid + "_canvas"である）

プログラムの流れ

app.init()

一時終了

画像がロードされて、app.onpreloadx()

すべてロードされて、app.afterOnload()

app.ready()→app.onscrollx()→this.start()

タイマで、app.run()

キー入力で、app.keyType()、app.keySense()

マウスで、app.onmousedownx()、app.onclickx()

タッチで、app.ontouchx()未開発

対応付け

一般 このプログラム

init afterOnload

*/

var parentEL = document.getElementById( "sl_monthlyJS_canvas" );

var app = new App( "sl_monthlyJS" );

addEventListener( "load", app.exec.bind( app, parentEL ), false );

//関数 1 / 31 ..

app.init = function() {

console.log( "-init" );

//canvasについて設定

this.canvasEL.style.border = "solid 0px red";

if( typeof baseURL !== "undefined" ) {

this.baseURL = baseURL;

this.setCanvasSize( setCanvasSizeW, setCanvasSizeH );

this.pixelsize = pixelsize; //モザイクサイズ

this.isWidth100per = isWidth100per; //canvasを親要素の横幅に合わせる

this.isScreenFit = isScreenFit;

this.isKeepAspect = isKeepAspect; //そのとき縦横アスペクト比を維持する

this.isPixelZoom = isPixelZoom; //ドットストレッチ

this.isSmoothZoom = isSmoothZoom; //スムーズストレッチ

} else {

this.baseURL = "20181125-indexJS/";

this.setCanvasSize( 512, 256 );

this.pixelsize = 2; //モザイクサイズ

this.isWidth100per = 1; //canvasを親要素の横幅に合わせる

this.isScreenFit = 0;

this.isKeepAspect = 0; //そのとき縦横アスペクト比を維持する

this.isPixelZoom = 0; //ドットストレッチ

this.isSmoothZoom = 0; //スムーズストレッチ

}

this.canvasEL.style.backgroundColor = "black";

//設定後の適用

this.canvasApply();

var p = document.getElementById( "whiteareaID" );

this.toBackgroundOf( p );

//定数

this.EnemyType = 1;

this.SupporterMissileType = 2;

this.FighterType = 4;

this.a = 0;

this.toA = -1;

this.toAMode = false;

this.pause = false;

//---画像

this.images = new Object();

this.imageSRCs = [

"map1.png",

"map2.png",

"map3.png",

"message1.png",

"fighter.png",

"sm.png",

"enemy1.png",

"enemy2.png",

"enemy3.png",

];

this.drawFLG = "preload";

this.preloadCNT = 0;

this.draw();

for( var i = 0; i < this.imageSRCs.length; i++ ) {

var img = new Image();

img.onload = this.onpreloadx.bind( this );

img.src = this.baseURL + this.imageSRCs[ i ];

img.name = this.imageSRCs[ i ].match( /^(.+)\./ )[ 1 ];

this.images[ img.name ] = img;

}

};

//関数 2 / 31 ..

app.onpreloadx = function( e ) {

this.preloadCNT++;

console.log( "preloaded: " + this.preloadCNT + "/" + Object.keys( this.images ).length + " : " + e.target.name );

this.draw();

//check.

if( 1 && this.preloadCNT == Object.keys( this.images ).length ) this.afterOnload();

};

//関数 3 / 31 ..

app.afterOnload = function() {

console.log( "afterOnload" );

this.drawFLG = "";

//星々

this.stars = new Array();

for( var i = 0; i < 30; i++ ) {

this.addStar( Math.random() * this.canvasW );

}

this.supporterMissiles = new Array();

this.enemies = new Array();

this.sprites = new Object();

this.enemyCnt = 0;

this.supporterMissileCnt = 0;

//自機

this.fighter = new Sprite( "fighter" );

with( this.fighter ) {

imagePalette = new ImagePalette( this.cc, this.images.fighter, 142, 36, 90, 36 );

x = 105;

y = 80;

setWidthWithAspectHeight( 38 );

type = this.FighterType;

}

this.entrySprite( this.fighter );

this.maps = new Maps( this );

//---スケジュール

this.schedule = new Array();

this.scheduleAdd( 5, function() {

var enemy = this.newEnemy( 2 );

enemy.y = this.canvasH / 3;

} );

var nico = function( tm ) {

//ニコ編隊

for( var j = 0; j < 5; j++ ) {

for( var i = 0; i < 5; i++ ) {

var tm2 = tm + i*2 + j * 50;

if( j % 2 ) {

this.scheduleAdd( tm2, function() {

var enemy = this.newEnemy( 1 );

enemy.y = this.canvasH / 3;

} );

} else {

this.scheduleAdd( tm2, function() {

var enemy = this.newEnemy( 1 );

enemy.y = this.canvasH / 3 * 2;

} );

}

}

}

}.bind( this );

nico( 10 );

nico( 650 );

//くるくるりぼん

tm = 350;

this.scheduleAdd( tm, function() { ( this.newEnemy( 2 ) ).y = this.canvasH / 4; } );

this.scheduleAdd( tm, function() { ( this.newEnemy( 2 ) ).y = this.canvasH / 4 * 3; } );

//上下サンドイッチ隊

var sandwich = function( tm ) {

this.scheduleAdd( tm, function() { this.newEnemy( 3, 1 ); } );

this.scheduleAdd( tm, function() { this.newEnemy( 3, 2 ); } );

this.scheduleAdd( tm, function() { this.newEnemy( 3, 3 ); } );

this.scheduleAdd( tm, function() { this.newEnemy( 3, 4 ); } );

this.scheduleAdd( tm, function() { this.newEnemy( 3, 5 ); } );

this.scheduleAdd( tm, function() { this.newEnemy( 4, 1 ); } );

this.scheduleAdd( tm, function() { this.newEnemy( 4, 2 ); } );

this.scheduleAdd( tm, function() { this.newEnemy( 4, 3 ); } );

this.scheduleAdd( tm, function() { this.newEnemy( 4, 4 ); } );

this.scheduleAdd( tm, function() { this.newEnemy( 4, 5 ); } );

}.bind( this );

sandwich( 540 );

sandwich( 950 );

this.scheduleAdd( 300, function() {

this.maps.ready( "map" );

} );

this.scheduleAdd( 1200, function() {

this.maps.ready( "message" );

} );

this.timerMS = 50;

this.ready();

};

//関数 4 / 31 ..

app.scheduleAdd = function( tm, func ) {

//check.

if( ! this.schedule[ tm ] ) this.schedule[ tm ] = new Array();

this.schedule[ tm ].push( func.bind( this ) );

}

//関数 5 / 31 ..

app.newEnemy = function( type, mutation ) {

var id = "enemy" + this.enemyCnt++;

var enemy = new Sprite( id, this );

with( enemy ) {

type = this.EnemyType;

imagePalette = new ImagePalette( this.cc, this.images.enemy1, 72, 50, 51, 50 );

x = this.canvasW;

y = this.canvasH / 2;

frame = function() {

//this is sprite.

this.moveFrameChecker( this.x < 0 );

this.animFrameChecker();

};

}

switch( type ) {

case 1:

//ニコ

with( enemy ) {

frame = function() {

//this is sprite.

this.moveFrameChecker( this.x < 0 );

this.imagePalette.index ++;

//check.

if( this.imagePalette.index > this.imagePalette.maxIndex ) this.imagePalette.index = 0;

};

moveFunction = function() {

var bx = this.x;

this.x -= this.speed / 2;

var f = function( x ) { return Math.sin( x * 0.1 ) * 30; }

this.y += f( this.x ) - f( bx );

};

}

break;

case 2:

//くるくるりぼん

with( enemy ) {

width = 48;

height = 48;

imagePalette = new ImagePalette( this.cc, this.images.enemy2, 72, 75, 60, 75 );

speed = 8;

animFrameMax = 3;

}

break;

case 3:

//サンドイッチ隊上から

with( enemy ) {

x = app.canvasW / 2 + 50 * mutation;

y = 0;

imagePalette = new ImagePalette( this.cc, this.images.enemy3, 72, 60, 60, 60 );

imagePalette.index = mutation;

width = 48;

height = 48;

animFrameMax = 4;

frame = function() {

//this is sprite.

this.moveFrameChecker( this.y > app.canvasH );

this.animFrameChecker();

};

moveFunction = function() {

this.x -= this.speed / 2;

this.y += this.speed;

};

}

break;

case 4:

//サンドイッチ隊下から

with( enemy ) {

x = app.canvasW / 2 + 50 * mutation;

y = app.canvasH;

imagePalette = new ImagePalette( this.cc, this.images.enemy3, 72, 60, 60, 60 );

imagePalette.index = mutation;

width = 48;

height = 48;

animFrameMax = 4;

frame = function() {

//this is sprite.

this.moveFrameChecker( this.y < 0 );

this.animFrameChecker();

};

moveFunction = function() {

this.x -= this.speed / 2;

this.y -= this.speed;

};

}

break;

}

this.entrySprite( enemy );

return enemy;

};

//関数 6 / 31 ..

app.entrySprite = function( sprite ) {

switch( sprite.type ) {

case this.EnemyType:

this.enemies.push( sprite );

break;

case this.SupporterMissileType:

this.supporterMissiles.push( sprite );

break;

case this.FighterType:

break;

default:

alert( "error at app.entrySprite\n\nundefined type: " + sprite.type );

}

this.sprites[ sprite.id ] = sprite;

}

//関数 7 / 31 ..

app.deleteSprite = function( sprite ) {

switch( sprite.type ) {

case this.EnemyType:

this.enemies.splice( this.enemies.indexOf( sprite ), 1 );

break;

case this.SupporterMissileType:

this.supporterMissiles.splice( this.supporterMissiles.indexOf( sprite ), 1 );

break;

case this.FighterType:

break;

default:

alert( "error at app.deleteSprite\n\nundefined type: " + sprite.type );

}

delete this.sprites[ sprite.id ];

};

//frame

//関数 8 / 31 ..

app.run = function() {

this.keySense();

//debug.

if( this.toAMode ) {

if( this.a == this.toA ) {

this.stop();

this.toAMode = false;

this.timerMS = this.toABak;

this.pause = true;

this.start();

}

}

if( this.pause ) {

this.draw();

return;

}

//スプライト

for( var name in this.sprites ) {

var sprite = this.sprites[ name ];

//check.

if( sprite.deleteFlg ) {

this.deleteSprite( sprite );

continue;

}

sprite.frame();

}

//スケジュール

if( this.schedule[ this.a ] ) {

for( var i = 0; i < this.schedule[ this.a ].length; i++ ) {

this.schedule[ this.a ][ i ]();

}

}

//地上

this.maps.frame();

//当たり判定

for( var i = 0; i < this.supporterMissiles.length; i++ ) {

var sm = this.supporterMissiles[ i ];

for( var j = 0; j < this.enemies.length; j++ ) {

var en = this.enemies[ j ];

//check.

if( en.deleteFlg ) continue;

var hitX1 = sm.x >= ( en.x - en.centerX );

var hitX2 = sm.x <= ( en.x + en.centerX );

var hitY1 = sm.y >= ( en.y - en.centerY );

var hitY2 = sm.y <= ( en.y + en.centerY );

if( hitX1 && hitX2 && hitY1 && hitY2 ) {

sm.deleteFlg = true;

en.deleteFlg = true;

break;

}

}

}

//背景　星々

for( var i = this.stars.length - 1; i >= 0; i-- ) {

var star = this.stars[ i ];

star[ 0 ] -= 4;

//check

if( star[ 0 ] < 0 ) this.stars.splice( i, 1 );

}

if( this.a % 5 == 0 ) { this.addStar( this.canvasW ); }

this.draw();

this.a++;

};

app.colors = [ "#00f", "#888", "yellow" ];

//関数 9 / 31 ..

app.addStar = function( gx ) {

var color = this.colors[ Math.floor( Math.random() * this.colors.length ) ];

gx = Math.round( gx );

var gy = Math.round( Math.random() * this.canvasH );

this.stars.push( [ gx, gy, color ] );

}

//関数 10 / 31 ..

app.drawTextCenter = function( t ) {

var cc = this.cc;

var sz = 24;

var met = cc.measureText( t );

var x = ( this.canvasW - met.width ) / 2 - met.width / 2;

var y = ( this.canvasH - sz ) / 2;

cc.font = sz + "px ''";

cc.fillStyle = "darkblue"; cc.fillText( t, x+4,y+4 );

cc.fillStyle = "cyan"; cc.fillText( t, x-2,y );

cc.fillStyle = "cyan"; cc.fillText( t, x+1,y );

cc.fillStyle = "cyan"; cc.fillText( t, x,y-2 );

cc.fillStyle = "cyan"; cc.fillText( t, x,y+1 );

cc.fillStyle = "blue"; cc.fillText( t, x,y );

}

//関数 11 / 31 ..

app.draw = function() {

var cc = this.cc;

cc.clearRect( 0, 0, this.canvasW, this.canvasH );

if( this.drawFLG == "preload" ) {

this.drawTextCenter( "PRELOADING IMAGES.." );

return;

}

//☆彡　描画

for( var i = this.stars.length - 1; i >= 0; i-- ) {

var star = this.stars[ i ];

var gx = star[ 0 ];

var gy = star[ 1 ];

cc.fillStyle = star[ 2 ];

cc.fillRect( gx, gy, 1, 1 );

}

//スプライト　描画

for( var name in this.sprites ) {

var sprite = this.sprites[ name ];

sprite.draw( cc );

}

//地上　描画

this.maps.draw( cc );

cc.font = "18px ''";

cc.fillStyle = "white";

cc.fillText( "a: " + this.a + " sprites: " + Object.keys( this.sprites ).length, 50, 20 );

if( this.pause ) {

this.drawTextCenter( "PAUSE" );

}

};

//関数 12 / 31 ..

app.keyType = function( keynum ) {

switch( keynum ) {

case 90: this.fire(); break; //z

case 65: //a

this.stop();

this.toA = Number( prompt( "moveto:", this.a ) );

this.toAMode = true;

this.toABak = this.timerMS;

this.timerMS = 1;

this.a = 0;

this.start();

break;

case 80: this.pause = ! this.pause; break; //p

default:

// console.log( this.id + " key typed: " + keynum );

}

};

//関数 13 / 31 ..

app.keySense = function() {

//keySenseはプログラマーがrun()などから適宜呼ぶ

//サンプル

//キーテーブルをすべて処理

for( var i = 0; i < this.keytable.length; i++ ) {

var keynum = this.keytable[ i ];

switch( keynum ) {

case 37: this.fighter.x -= this.fighter.speed; break;

case 39: this.fighter.x += this.fighter.speed; break;

case 38: this.fighter.y -= this.fighter.speed; break;

case 40: this.fighter.y += this.fighter.speed; break;

default:

}

}

};

//関数 14 / 31 ..

app.fire = function() {

var missile = new Sprite( "sm" + this.supporterMissileCnt++, this );

with( missile ) {

type = this.SupporterMissileType;

imagePalette = new ImagePalette( this.cc, this.images.sm );

x = this.fighter.x + this.fighter.centerX - 8;

y = this.fighter.y + 4;

speed += 8;

setWidthWithAspectHeight( 8 );

frame = function() {

//"this" is missile.

this.x += this.speed;

this.deleteFlg = this.x > this.app.canvasW;

};

}

this.entrySprite( missile );

};

//---class

//関数 15 / 31 ..

function ImagePalette( cc, image, areaWidth, areaHeight, width, height ) {

this.cc = cc;

this.image = image;

if( arguments.length == 2 ) {

this.drawImage = this.drawImage_single;

this.width = this.image.width;

this.height = this.image.height;

} else {

this.areaWidth = areaWidth;

this.areaHeight = areaHeight;

this.width = width;

this.height = height;

this.columns = Math.floor( image.width / this.areaWidth );

this.rows = Math.floor( image.height / this.areaHeight );

this.maxIndex = this.columns * this.rows;

this.index = 0;

}

}

//関数 16 / 31 ..

ImagePalette.prototype.drawImage = function( dx, dy, dw, dh ) {

var sx = this.index * this.areaWidth;

this.cc.drawImage( this.image, sx, 0, this.width, this.height, dx, dy, dw, dh );

};

//関数 17 / 31 ..

ImagePalette.prototype.drawImage_single = function( dx, dy, dw, dh ) {

this.cc.drawImage( this.image, dx, dy, dw, dh );

};

//関数 18 / 31 ..

function Sprite( id, app ) {

this.app = app;

this.type = null;

this.id = id;

this.imagePalette = null;

this.x = 100;

this.y = 100;

this.setWidth( 32 );

this.setHeight( 32 );

this.speed = 8;

this.deleteFlg = false;

this.moveFrameCnt = 0;

this.moveFrameMax = 1;

this.animFrameCnt = 0;

this.animFrameMax = 1;

}

//関数 19 / 31 ..

Sprite.prototype.setWidth = function( width ) {

this.width = width;

this.centerX = width / 2;

};

//関数 20 / 31 ..

Sprite.prototype.setHeight = function( height ) {

this.height = height;

this.centerY = height /2;

}

//関数 21 / 31 ..

Sprite.prototype.setWidthWithAspectHeight = function( width ) {

this.setWidth( width );

this.setHeight( this.width / this.imagePalette.width * this.imagePalette.height );

};

//関数 22 / 31 ..

Sprite.prototype.draw = function( cc ) {

cc.save();

cc.translate( this.x - this.centerX, this.y - this.centerY );

this.imagePalette.drawImage( 0, 0, this.width, this.height );

cc.restore();

};

//関数 23 / 31 ..

Sprite.prototype.frame = function( cc ) {

};

//関数 24 / 31 ..

Sprite.prototype.moveFunction = function( cc ) {

this.x -= this.speed;

};

//関数 25 / 31 ..

Sprite.prototype.animFrameChecker = function( cc ) {

if( this.animFrameCnt++ == this.animFrameMax ) {

this.animFrameCnt = 0;

this.imagePalette.index ++;

//check.

if( this.imagePalette.index > this.imagePalette.maxIndex ) this.imagePalette.index = 0;

}

};

//関数 26 / 31 ..

Sprite.prototype.moveFrameChecker = function( isDelete ) {

if( this.moveFrameCnt++ == this.moveFrameMax ) {

this.moveFrameCnt = 0;

this.moveFunction();

this.deleteFlg = isDelete;

}

}

//関数 27 / 31 ..

function Maps( app ) {

this.app = app;

this.array = new Array();

this.visibles = new Array();

this.frameCnt = 0;

this.frameMax = 1;

this.index = 0;

this.movePixel = 4;

}

//関数 28 / 31 ..

Maps.prototype.ready = function( mapName ) {

this.array = new Array();

var nums = new Array();

for( var name in this.app.images ) {

if( name.indexOf( mapName ) == 0 ) {

var num = Number( name.substr( mapName.length ) );

nums.push( num );

}

}

nums.sort( function( a, b ) {

if( a < b ) return -1;

if( a > b ) return 1;

return 0;

} );

for( var i = 0; i < nums.length; i++ ) {

this.array.push( new Map( this.app.images[ mapName + nums[ i ] ] ) );

}

this.visibles.push( this.array[ 0 ] );

this.index = 0;

}

//関数 29 / 31 ..

Maps.prototype.frame = function() {

//check.

if( this.frameCnt++ != this.frameMax ) {

return;

}

this.frameCnt = 0;

var allEnd = true;

for( var i = 0; i < this.visibles.length; i++ ) {

var map = this.visibles[ i ];

//サイズを更新（ウィンドウリサイズを考慮して）

map.width = map.image.width * ( this.app.canvasH / map.image.height );

map.height = this.app.canvasH;

map.scrollX += this.movePixel;

map.endFlg = map.scrollX >= map.width + this.app.canvasW;

//check.　画面右端にマッチして、次のマップが必要か。

if( map == this.array[ this.index ] && map.scrollX >= map.width ) {

this.index++;

console.log( 321, this.index );

if( this.index < this.array.length ) {

this.visibles.push( this.array[ this.index ] );

}

}

if( map.endFlg == false ) {

allEnd = false;

}

}

if( allEnd ) {

this.visibles = new Array();

}

}

//関数 30 / 31 ..

Maps.prototype.draw = function( cc ) {

for( var i = 0; i < this.visibles.length; i++ ) {

var map = this.visibles[ i ];

cc.drawImage( map.image, this.app.canvasW - map.scrollX, 0, map.width, map.height );

}

}

//関数 31 / 31 ..

function Map( image ) {

this.scrollX = 0;

this.image = image;

this.endFlg = false;

this.width = 0;

this.height = 0;

}

//---/class

※上のメニューのabout this website.html にもあるように、特に著作権は主張しないので、プログラムで使いたいものがあったら自由に使ってください。

ファイル一式 (2MB)おてもとのPCで動作できます。

動作確認ブラウザ：

• Windows10 Firefox Quantum ver. 64.0
• Windows10 Google Chrome ver. 71.0　（※一番動きが良い）
• Windows10 Microsoft Edge ver. 42.17
• Windows10 Internet Explorer ver. 11.472

2018/12/19（水）

冒頭のお姉さんの画像（下図左）の髪型をどうにかしようと思って いじっていたんですが、やっぱり絵というのは「ソラ」（資料なし）では描けなくて、うまく描けませんでした。

そういう「描けない！」というときの手段として、やはり「資料を使う」という方法があります。

下図中央の写真は、あるテレビ番組のワンショットです。（肖像権とかあると思うので、おおざっぱにモザイクをかけてあります）

この写真を見ながら髪型を作ることにしました。

それでできたのが下図右です。下図左と比べてだいぶグッとくる絵になりました。

　＋　　＝　

こうやって資料を基にしてたくさん描くと、それが身について、資料を見なくても描けるようになるんだと思います。

髪型のほか、顔の りんかく も「描けない！」と思っていたんですが、髪型がこのようにエレガントになると、つられて「りんかく」もキュートになるようにいじることができました。

この「つられて描ける」ようになることを、個人的に「ラブリーメソッドが はたらいた」と呼んでいます。

いわゆるノリのことで、ノッてきた～！と思うと、エンジンがかかって、ほかの部分も急にグレードが上がるんです。

たとえば、四角形をポンと置いて、その塗りつぶしを青から肌色に変えるとノッてきます。

人間キャラを描くんだぞ、という気になります。

適当に描いた目を、もっと魅力的に描きこむとノッてきます。

上図右に髪の毛を配置したら見栄えするだろうし、鼻あたりのりんかくを加えたら良くなりそうです。

このように「次」をうながす魅力的な何かを「ラブリーメソッド」と私は最近呼んでいます。絵を続けて描こうという気になるんです。

そういうわけで描きこんだ目に、下図のように図形を配置するだけで何かに見えませんか？

こんなふうに、描く気はなかったのにエンジンがかかるんです。

上図右の女の子は「コレを描こう！」と思ってできた絵ではなく、なりゆきのおもいつきで出来上がった絵です。

絵を描くとき、何か最初に注文があってその注文に応える形で描く絵と、何も注文がないところ思い付きで描く絵と２種類があると思います。

注文のとおりに描ければ、絵でご飯が食べていけると思います。私は誰かに頼まれて描く絵（注文に応える）というのがとても苦手です。

話は脱線しましたが、「資料」を使うほか、「ラブリーメソッド」（魅力的なパーツを投入する）を使うことでも、絵というのはエンジンがかかるんです。

（資料やラブリーメソッドだけで絵を描けるかどうかはわかりませんが、日ごろから絵について練習してみたり、研究することは必要です。必要ですと言われてやるんじゃなくて（やってもいいけど）、もしかしたらある程度誰かから褒められて絵を描く自分を作ってもらえること（そういう人生）が必要なのかもしれない。今絵が下手だからダメなんだではなく、その絵をバカにせず、才能の芽を見つけ出して褒めてくれる人がいると良い、のかなぁ。お世辞でほめるんじゃなくて、下手だとされるその絵の中で、ある部分が芸術として本当に有効だとわかって褒めてくれる人）

2018/12/15（土） [2024年 システム調整 対策済み]

今週の木曜日のこと。

会社からの帰宅中、20:40ごろ。

暗がりに子猫らしい鳴き声が聞こえるので、あたりを見渡したら、生後数か月くらいの白黒模様の子猫がいました。

普通の猫は、人間が寄ると逃げますが、子猫だったせいか私が寄っても逃げませんでした。

この寒いのに…飼い猫であれば外に出るような気温じゃないはず。首輪はなくて野良猫らしい。

私がしゃがむと、ヒザに乗っかってきました。

そして私の肩によじ登り、リュックサックの上が平べったいタイプだったせいか、そこに陣取りました。おっとっと、おっとっと

通行人が二人くらい。

自宅に連れて帰るのはどう考えても無理だったので、誰かに引き取ってもらうことを考えましたが、それも無理でしょう。

このままずっと、というわけにもいかないので、立ち去るタイミングを探していたら、それがわかるらしく、

犬が飼い主にあまえるような感じで、立った私のヒザに両手で すがって「いかないで」。猫らしくないしぐさ。よっぽど一人でいるのがつらいみたい。

年の瀬で飲み会帰りのビジネスマンが車で送ってもらって降りてきて、それに気を取られているすきを狙って私は立ち去りましたが、

私の姿が見えなくなったせいか、また一人になったせいか、その鳴き声がかなしげ。

私は自宅に向かって帰る途中、何かにギューっと押しつぶされたようなやりきれない気持ちになりました。その気持ちがだいぶ強力でした。

まったく悲しくはありませんが、心が押しつぶされる感覚が非常に強かった。これでもかと縄で心を縛り付け、頭に来ながら我慢するような感じ。

もちろん子猫に対して頭に来ているのではなく、何もできなくて置き去りにするしかない状況に対して。

自宅に着いて玄関に立ち、そのまま10分くらい動けず、結局コンビニへ行ってキャットフード（にくまんなど人間の食べ物をあげるのはおなか壊すし糖尿病にもなるので不可で、カルカンが研究しつくされているのでカルカンが良い）を買い、再びその場所へ行くと猫の姿はありませんでした。

よくよく考えると、今年の６月ごろ、同じ白黒模様のおなかの大きな妊娠中の猫を見た気がします。ガラが同じなのでその生まれた子供だと思います。

12/14（金）は、「あっ見えた！感動～」

ふたご座流星群が見られるというので、部屋から外に出て空を見上げました。

５分ほど見上げていると、スイーッと１つ流れ星が見えました。

たくさん見られると言うので、その後も見ようとしましたが、首が痛くなってきたのであきらめました。

１つ見られれば十分。

22時ごろ見ましたが、一番良いのは21時ごろらしいです。

最近やっているプログラミングは下図のようなもの。

Microsoft ExcelのVBAで、「関節が稼働するデッサン人形みたいなもの」（私がいつも言っているSVC）を作成するソフトウェアを作っています。

今まではVBAの「フォーム」という方法で操作画面を作っていましたが、Windowsの「リボン」が使えることを知って、「リボン」へと移行しています。

「フォーム」は下図のように Excelの画面上に浮いていて、作業エリアを覆ってしまうので作業しづらいですが、

「リボン」はリボンのエリアに収まるので、作業エリアが覆われず、すっきり！

▼こんな画面でプログラミングしています。

▼過去に作ったSVC画像。

SVCは、関節をクルクル動かすだけの簡単操作なのに、上図のように結構 表現力が豊かです。しかし、「SVCは」というより、絵を描くこと自体がもともとそういうものなのかもしれません。絵を教えるとき、誰でも必ず「最初は単純な図形でとらえましょう」と言うし、その単純な図形を関節で曲げることを考えれば、それはSVCでやってることと同じになります。

VBAのコード （作り途中のものですが、興味のある方はクリックして表示してください）

''- 関数リスト -

'' 1: ShapeEX_onload

'' 2: checkBox_getPressed

'' 3: ribbon10a

'' 4: getBlankLeft

'' 5: swapConnectors

'' 6: ribbon10a_

'' 7: afterShapesMoveBy

'' 8: getConnectorBefore

'' 9: getConnectorsAfter

'' 10: ribbon16

'' 11: ribbon12

'' 12: ribbon13

'' 13: ribbon14

'' 14: ribbon15

'' 15: ribbon11

'' 16: ribbon8a

'' 17: ribbon8b

'' 18: ribbon8c

'' 19: ribbon8d

'' 20: SpinButton1_SpinSub

'' 21: kaitenShapes

'' 22: ribbon10

'' 23: treeMoveBy

'' 24: kaitenTree

'' 25: kaitenShape

'' 26: kaiten2

'' 27: ribbon9

'' 28: ribbon8

'' 29: Collection_indexOf

'' 30: ribbon7

'' 31: makeConnector

'' 32: Collection_existsByName

'' 33: ribbon6

'' 34: ribbon5

'' 35: ribbon4

'' 36: ribbon3

'' 37: selectionIsError

'' 38: alert

'' 39: alert_click

'' 40: getSvcsBefore

'' 41: Collection_concat

'' 42: getSvcsAfter

'' 43: searchConnectorsOnArm

'' 44: ButtonSelectConnectors_Click

'' 45: updateConnectorVisible

'' 46: ButtonSelectAll_Click

'' 47: getAllSvcs

'' 48: getAllArms

'' 49: getAllConnectors

'' 50: searchUTL

'' 51: searchShapesByKey

'' 52: connectorName2arms

'名称：

'すべての図形 図形 shape

'図形と図形を結ぶ意味を持つ図形 コネクタ connector

'コネクタに連なる図形 アーム arm

'コネクタとアーム svc svc

Option Explicit

Private acShapes As Shapes

Private sw_connectorVisible As Boolean

Private shapeEX_alert As Shape

Private all As Collection

Private connectors As Collection

Private arms As Collection

Private tree As TreeObjectClass

Private noParents As Collection

''関数 1 / 52

Public Sub ShapeEX_onload(Optional ribbonControl As IRibbonControl = Null)

Debug.Print "ShapeEX_onload"

Set acShapes = ActiveSheet.Shapes

sw_connectorVisible = True

End Sub

'チェックボックス初期値

''関数 2 / 52

Sub checkBox_getPressed(ribbonControl As IRibbonControl, ByRef returnValue)

Select Case ribbonControl.ID

Case "checkBox1"

returnValue = True

End Select

End Sub

''関数 3 / 52

Private Sub ribbon10a(ribbonControl As IRibbonControl)

'check

If selectionIsError(False, True, True, 2) Then Exit Sub

Dim connector As Shape

'アームが選択されていたらコネクタを選択しなおす。

Dim orgSelection As Collection

Set orgSelection = New Collection

Dim newSelection As Collection

Set newSelection = New Collection

Dim arms As Collection

Set arms = getAllArms

Dim connectors As Collection

Set connectors = getAllConnectors

'各選択について

Dim theShape As Shape

For Each theShape In Selection.ShapeRange

orgSelection.add theShape

If Collection_indexOf(arms, theShape) > -1 Then

'選択はアームである

'check. アームに続くコネクタが１つあり、そのコネクタは子を持たない場合について

Dim connectorsAfter As Collection

Set connectorsAfter = getConnectorsAfter(theShape)

If connectorsAfter.Count = 1 Then

If connectorsAfter.item(1).name Like "*>" Then

newSelection.add connectorsAfter.item(1)

GoTo continue

End If

End If

Set connector = getConnectorBefore(theShape)

'check. トップアームにはコネクタがないので

If connector Is Nothing Then

MsgBox "this is top."

Exit Sub

End If

newSelection.add connector

ElseIf Collection_indexOf(connectors, theShape) > -1 Then

'選択はコネクタである

newSelection.add theShape

Else

'選択はその他である（アームでもコネクタでもない図形）

newSelection.add makeConnector(theShape, False)

End If

continue:

Next theShape

'以降コネクタを対象にした処理

'選択状態の分析

Dim theName As String

Dim countOfHasParent As Integer

countOfHasParent = 0

Dim countOfHasChild As Integer

countOfHasChild = 0

Dim countOfHasNoChild As Integer

countOfHasNoChild = 0

For Each theShape In newSelection

theName = theShape.name

If theName Like "*>" Then

countOfHasParent = countOfHasParent + 1

countOfHasNoChild = countOfHasNoChild + 1

ElseIf theName Like ">*" Then

countOfHasChild = countOfHasChild + 1

ElseIf theName Like "*>*" Then

countOfHasParent = countOfHasParent + 1

countOfHasChild = countOfHasChild + 1

Else

'ここにくることはないはず

MsgBox "err"

End If

Next theShape

Dim fromConnector As Shape

Dim toConnector As Shape

Application.ScreenUpdating = False

If newSelection.Count = 1 Then

'そのコネクタは子を持っているか

theName = newSelection.item(1).name

If theName Like "*>" Then

'子を持っていない（手など）

'手に持っていないところ、何か手に持つ。

Debug.Print "1 手に持っていないところ、何か手に持つ。"

ElseIf theName Like ">*" Then

'子を持っている、親を持っていない（手放したアイテムなど）

Debug.Print "2 その物を両手どちらかに持たせる"

Else

'子を持っている、親を持っている（手にアイテムを持っている）

Debug.Print "3 持っているものを手放す"

'持ち物

Set fromConnector = newSelection.item(1)

'ダミー位置

Set toConnector = getAllConnectors.item(1)

toConnector.Copy

ActiveSheet.Paste

Set toConnector = Selection.ShapeRange.item(1)

toConnector.name = ">"

toConnector.left = getBlankLeft(fromConnector)

toConnector.top = fromConnector.top

toConnector.Rotation = 0

swapConnectors fromConnector, toConnector

orgSelection.item(1).Select False

End If

ElseIf Selection.ShapeRange.Count = 2 Then

If countOfHasChild = 2 Then

Debug.Print "4 通常スワップ"

ElseIf countOfHasChild = 1 And countOfHasNoChild = 1 Then

If countOfHasParent = 2 Then

Debug.Print "5 持ち替える"

Else

Debug.Print "6 手に何かを持つ"

swapConnectors newSelection.item(1), newSelection.item(2)

If newSelection.item(1).name Like "*>" Then

newSelection.item(1).Delete

orgSelection.item(2).Select

ElseIf newSelection.item(2).name Like "*>" Then

newSelection.item(2).Delete

orgSelection.item(1).Select

End If

End If

Else

Debug.Print "両方とも手"

End If

End If

Application.ScreenUpdating = True

End Sub

''関数 4 / 52

Private Function getBlankLeft(targetShape) As Integer

'アイテムを置く位置を検索

Dim toCenterX As Integer

toCenterX = targetShape.left + targetShape.Width / 2 + 200

Dim toCenterY As Integer

toCenterY = targetShape.top + targetShape.Height / 2

'check.

Dim theShape As Shape

Dim shapeCenterX As Integer

Dim shapeCenterY As Integer

Dim tole As Integer: tole = 20

Dim thereIsSameLeft As Boolean

Do

continue:

thereIsSameLeft = False

For Each theShape In acShapes

shapeCenterX = theShape.left + theShape.Width / 2

shapeCenterY = theShape.top + theShape.Height / 2

If toCenterX > shapeCenterX - tole And toCenterX < shapeCenterX + tole And toCenterY > shapeCenterY - tole And toCenterY < shapeCenterY + tole Then

Debug.Print "近い", theShape.name

thereIsSameLeft = True

toCenterX = toCenterX + 100

GoTo continue

End If

Next theShape

Loop While thereIsSameLeft

getBlankLeft = toCenterX - targetShape.Width / 2

End Function

''関数 5 / 52

Private Sub swapConnectors(connector1 As Shape, connector2 As Shape)

Debug.Print "swap", connector1.name, connector2.name

'コネクタ１と２の距離

Dim diffLeft As Integer, diffTop As Integer

Dim centerLeft1 As Integer, centerTop1 As Integer

Dim centerLeft2 As Integer, centerTop2 As Integer

centerLeft1 = connector1.left + connector1.Width / 2

centerTop1 = connector1.top + connector1.Height / 2

centerLeft2 = connector2.left + connector2.Width / 2

centerTop2 = connector2.top + connector2.Height / 2

diffLeft = centerLeft1 - centerLeft2

diffTop = centerTop1 - centerTop2

Dim tokens1 As Variant

tokens1 = Split(connector1.name, ">")

Dim tokens2 As Variant

tokens2 = Split(connector2.name, ">")

'コネクタ２と連なるものの位置移動

Dim theShape As Shape

Dim afterShapes1 As Collection

Dim firstshape1 As Shape

Dim afterShapes2 As Collection

Dim firstshape2 As Shape

Set afterShapes2 = getSvcsAfter(connector2)

If afterShapes2.Count = 1 Then

Set firstshape2 = afterShapes2.item(1)

Else

Set firstshape2 = afterShapes2.item(2)

End If

For Each theShape In afterShapes2

theShape.left = theShape.left + diffLeft

theShape.top = theShape.top + diffTop

Next theShape

connector2.Select

connector1.name = tokens2(0) & ">" & tokens1(1)

connector2.name = tokens1(0) & ">" & tokens2(1)

'コネクタ１と連なるものの位置移動

Set afterShapes1 = getSvcsAfter(connector1)

If afterShapes1.Count = 1 Then

Set firstshape1 = afterShapes1.item(1)

Else

Set firstshape1 = afterShapes1.item(2)

End If

For Each theShape In afterShapes1

theShape.left = theShape.left - diffLeft

theShape.top = theShape.top - diffTop

Next theShape

'回転

Dim diffRotation As Double

diffRotation = firstshape1.Rotation - firstshape2.Rotation

Dim diffTheta As Double

diffTheta = WorksheetFunction.Radians(diffRotation)

kaitenShapes firstshape1, -diffTheta, True

kaitenShapes firstshape2, diffTheta, True

End Sub

''関数 6 / 52

Private Sub ribbon10a_(ribbonControl As IRibbonControl)

Dim arms As Collection

Set arms = getAllArms

'check.

' If Collection_indexOf(arms, arm1) = -1 Or Collection_indexOf(arms, arm2) = -1 Then

' MsgBox "両方ともアームでなくてはなりません"

' Exit Sub

' End If

'備考

'この関数はまともに動いているが、コードがあまりきれいじゃない。

'準備

Dim arm1 As Shape

Dim connector1 As Shape

Dim arm2 As Shape

Dim connector2 As Shape

If Selection.ShapeRange.Count = 1 Then

Set shape1 = Selection.ShapeRange.item(1)

If shape1.name Like "*>*" Then

Set arm1 = Nothing

Set connector1 = shape1

ElseIf Collection_indexOf(arms, shape1) > -1 Then

Set arm1 = shape1

Set connector1 = getConnectorBefore(arm1)

End If

ElseIf Selection.ShapeRange.Count = 2 Then

Set arm1 = Selection.ShapeRange.item(1)

Set arm2 = Selection.ShapeRange.item(2)

Else

End If

Dim afterShapes1 As Collection

Dim firstshape1 As Shape

Dim afterShapes2 As Collection

Dim firstshape2 As Shape

Dim theShape As Shape

'コネクタ１について

Set arm1 = Selection.ShapeRange.item(1)

Set connector1 = getConnectorBefore(arm1)

Dim tokens1 As Variant

tokens1 = Split(connector1.name, ">")

'check　選択が１つ（コネクタ１で持っているアイテムを手放す）「→」

If Selection.ShapeRange.Count = 1 Then

'位置を交換する相手がないので、アイテムを置く位置を検索

Dim blankLeft As Integer

blankLeft = 200

'check.

Dim t As Integer: t = 16

Dim thereIsSameLeft As Boolean

Dim theLeft As Integer, theTop As Integer

Do

continue:

thereIsSameLeft = False

For Each theShape In acShapes

theLeft = connector1.left + blankLeft

theTop = connector1.top

If theLeft > theShape.left - t And theLeft < theShape.left + t And theTop > theShape.top - t And theTop < theShape.top + t Then

thereIsSameLeft = True

blankLeft = blankLeft + 100

GoTo continue

End If

Next theShape

Loop While thereIsSameLeft

afterShapesMoveBy connector1, blankLeft, 0

connector1.name = ">" & tokens1(1)

acShapes(tokens1(0)).Select

ButtonNewConnectorAt_Click

'ButtonUpdate2newInfo_Click

'ListBoxNoParentShapes.Selected(ListBoxSearchIndexOf(userform1.ListBoxNoParentShapes, connector1.name)) = True

Set afterShapes1 = getSvcsAfter(connector1)

Set firstshape1 = afterShapes1.item(2)

kaitenShapes connector1, -WorksheetFunction.Radians(firstshape1.Rotation), True

Exit Sub

End If

'コネクタ２について

Set arm2 = Selection.ShapeRange.item(2)

Set connector2 = getConnectorBefore(arm2)

Dim tokens2 As Variant

tokens2 = Split(connector2.name, ">")

'コネクタ１と２の距離

Dim diffLeft As Integer, diffTop As Integer

Dim centerLeft1 As Integer, centerTop1 As Integer

Dim centerLeft2 As Integer, centerTop2 As Integer

centerLeft1 = connector1.left + connector1.Width / 2

centerTop1 = connector1.top + connector1.Height / 2

centerLeft2 = connector2.left + connector2.Width / 2

centerTop2 = connector2.top + connector2.Height / 2

diffLeft = centerLeft1 - centerLeft2

diffTop = centerTop1 - centerTop2

'コネクタ２と連なるものの位置移動（手に持つ）「←」

Set afterShapes2 = getSvcsAfter(connector2)

Set firstshape2 = afterShapes2.item(2)

For Each theShape In afterShapes2

theShape.left = theShape.left + diffLeft

theShape.top = theShape.top + diffTop

Next theShape

Debug.Print "z2", firstshape2.ZOrderPosition

Debug.Print "z1", acShapes(tokens1(0)).ZOrderPosition

connector2.Select

connector2.name = tokens1(0) & ">" & tokens2(1)

If Not tokens1(1) = "" Then connector1.name = ">" & tokens1(1)

If connector1.name Like "*>" Then

'最初何も持っていなかった場合（コネクタ２その他が移動するだけで、終了）

connector1.Delete

'リストボックスを選択しておく

' ListBoxNoParentShapes.Selected(0) = True

Else

'最初何か持っていた場合（コネクタ１と２は位置を交換）「→←」

'コネクタ１と連なるものの位置移動

Set afterShapes1 = getSvcsAfter(connector1)

Set firstshape1 = afterShapes1.item(2)

For Each theShape In afterShapes1

theShape.left = theShape.left - diffLeft

theShape.top = theShape.top - diffTop

Next theShape

'回転

Dim diffRotation As Double

diffRotation = firstshape1.Rotation - firstshape2.Rotation

Dim diffTheta As Double

diffTheta = WorksheetFunction.Radians(diffRotation)

kaitenShapes firstshape1, -diffTheta, True

kaitenShapes firstshape2, diffTheta, True

'リストボックスを選択しておく

' ListBoxNoParentShapes.Selected(ListBoxSearchIndexOf(userform1.ListBoxNoParentShapes, connector1.name)) = True

End If

End Sub

''関数 7 / 52

Private Sub afterShapesMoveBy(targetShape As Shape, addLeft As Integer, addTop As Integer)

Dim theShapes As Collection

Set theShapes = getSvcsAfter(targetShape)

Dim theShape As Shape

For Each theShape In theShapes

theShape.left = theShape.left + addLeft

theShape.top = theShape.top + addTop

Next theShape

End Sub

'そのアームがつながるコネクタを得る

''関数 8 / 52

Private Function getConnectorBefore(arm As Shape) As Shape

Dim theShapes As Collection

Set theShapes = searchShapesByKey("*>" & arm.name)

If theShapes.Count = 0 Then

Set getConnectorBefore = Nothing

ElseIf theShapes.Count = 1 Then

Set getConnectorBefore = theShapes.item(1)

Else

'エラー　ツリーの枝が合流してしまっている

Set getConnectorBefore = Null

End If

End Function

'そのアームにつながるコネクタを得る

''関数 9 / 52

Private Function getConnectorsAfter(arm As Shape) As Collection

Set getConnectorsAfter = searchShapesByKey(arm.name & ">*")

End Function

'ボタン　選択図形（複数可）を 角度 0°にする（ツリーを無視して）

''関数 10 / 52

Private Sub ribbon16(ribbonControl As IRibbonControl) 'ButtonSetRotation0_Click

Dim theShape As Shape

For Each theShape In Selection.ShapeRange

theShape.Rotation = 0

Next

End Sub

'最前面

''関数 11 / 52

Private Sub ribbon12(ribbonControl As IRibbonControl) 'ButtonToMostFront_Click

'check.

If selectionIsError(False, True, True) Then Exit Sub

Selection.ShapeRange.ZOrder msoBringToFront

End Sub

'前面

''関数 12 / 52

Private Sub ribbon13(ribbonControl As IRibbonControl) 'ButtonToFront_Click

'check.

If selectionIsError(False, True, True) Then Exit Sub

Selection.ShapeRange.ZOrder msoBringForward

End Sub

'背面

''関数 13 / 52

Private Sub ribbon14(ribbonControl As IRibbonControl) 'ButtonToRear_Click

'check.

If selectionIsError(False, True, True) Then Exit Sub

Selection.ShapeRange.ZOrder msoSendBackward

End Sub

'最背面

''関数 14 / 52

Private Sub ribbon15(ribbonControl As IRibbonControl) 'ButtonToMostRear_Click

'check.

If selectionIsError(False, True, True) Then Exit Sub

Selection.ShapeRange.ZOrder msoSendToBack

End Sub

'ボタン　選択図形の枠線を２重線にする

'２重線は、「以前を回転」する場合に、回転の中心のコネクタを決める処理で、「２重線のコネクタ」を優先する。

'たとえば、胸以前を回転する場合、胸には腹、左腕、右腕のコネクタがあり、左腕のコネクタを中心に回転してしまうと意図した回転にならない

'腹のコネクタの枠線を２重線にすれば、２重線を頼りに腹を優先するようになる。腹のコネクタを中心に回転すれば意図した回転になる。

''関数 15 / 52

Private Sub ribbon11(ribbonControl As IRibbonControl) 'ButtonSetLineStyle2thinthin_Click

Dim connector As Shape

For Each connector In Selection.ShapeRange

connector.line.Style = msoLineThinThin

connector.line.Weight = 3

connector.line.ForeColor.RGB = connector.Fill.ForeColor.RGB

connector.line.Transparency = connector.Fill.Transparency

connector.line.Visible = True

Next connector

End Sub

'以前を左回転

''関数 16 / 52

Private Sub ribbon8a(ribbonControl As IRibbonControl) 'SpinButtonBefore_Spindown

'check

If selectionIsError(False, True, False) Then Exit Sub

SpinButton1_SpinSub -0.02, False 'booleanはorder

End Sub

'以前を右回転

''関数 17 / 52

Private Sub ribbon8b(ribbonControl As IRibbonControl) 'SpinButtonBefore_Spinup

SpinButton1_SpinSub 0.02, False 'booleanはorder

End Sub

'以後を左回転

''関数 18 / 52

Private Sub ribbon8c(ribbonControl As IRibbonControl) 'SpinButtonAfter_Spindown

'check

If selectionIsError(False, True, False) Then Exit Sub

SpinButton1_SpinSub -0.02, True 'booleanはorder

End Sub

'以後を右回転

''関数 19 / 52

Private Sub ribbon8d(ribbonControl As IRibbonControl) 'SpinButtonAfter_Spinup

'check

If selectionIsError(False, True, False) Then Exit Sub

SpinButton1_SpinSub 0.02, True 'booleanはorder

End Sub

'スピンボタン　サブルーチン

''関数 20 / 52

Private Sub SpinButton1_SpinSub(theta2add As Double, order As Boolean)

'check

If selectionIsError(False, True, False) Then Exit Sub

'図形を取得

Dim targetSvc As Shape

Set targetSvc = ActiveSheet.Shapes(Selection.name)

kaitenShapes targetSvc, theta2add, order

End Sub

''関数 21 / 52

Private Sub kaitenShapes(targetSvc As Shape, theta2add As Double, order As Boolean)

'回転の中心

Dim connectors As Collection

Dim centerSvc As Shape

Set connectors = searchConnectorsOnArm(targetSvc, Not order) '5

If connectors.Count = 0 Then

Set centerSvc = targetSvc

Else

Set centerSvc = connectors.item(1)

'もし、枠線がmsoLineThinThinであるコネクタがあるならそれを採用

Dim connector As Shape

For Each connector In connectors

If connector.line.Style = msoLineThinThin Then Set centerSvc = connector

Next connector

End If

Dim svcs As Collection

If order Then

Set svcs = getSvcsAfter(targetSvc)

Else

Set svcs = getSvcsBefore(targetSvc, "[" & centerSvc.name & "]")

End If

Dim i As Integer

For i = 1 To svcs.Count

kaitenShape centerSvc, svcs.item(i), theta2add

Next i

End Sub

'ボタン　選択図形（１つ）を ツリーとして 角度 0°にする

'このプログラム中の順方向の補正距離orderDX,Yは使用していないが、

'使用する可能性があるので、取っておく

''関数 22 / 52

Private Sub ribbon10(ribbonControl As IRibbonControl) 'ButtonSetTreeRotation0_Click

'選択図形

Dim svc As Shape

Set svc = ActiveSheet.Shapes(Selection.name)

'選択図形の中心

Dim centerX As Double, centerY As Double

centerX = svc.left + svc.Width / 2

centerY = svc.top + svc.Height / 2

Dim theta2 As Double

theta2 = WorksheetFunction.Radians(svc.Rotation)

'雑用

Dim connectors As Collection

Dim connector As Shape

Dim connectorX As Double, connectorY As Double

Dim kaitenConnector As Collection

'--不要かもしれない　ここから

'順方向の補正距離

Dim orderDX As Double, orderDY As Double

orderDX = 0

orderDY = 0

'選択図形上の順方向コネクタを取得

Set connectors = searchConnectorsOnArm(svc, True) '1

'check　順方向コネクタあるなら

If connectors.Count > 0 Then

Set connector = connectors.item(1)

'コネクタの中心

connectorX = connector.left + connector.Width / 2

connectorY = connector.top + connector.Height / 2

Set kaitenConnector = kaiten2(centerX, centerY, connectorX, connectorY, -theta2)

orderDX = kaitenConnector("x") - connectorX

orderDY = kaitenConnector("y") - connectorY

End If

'--不要かもしれない　ここまで

'逆方向の補正距離

Dim reverseDX As Double, reverseDY As Double

reverseDX = 0

reverseDY = 0

'選択図形上逆方向コネクタを取得

Set connectors = searchConnectorsOnArm(svc, False) '1

'check　逆方向コネクタあるなら

If connectors.Count > 0 Then

Set connector = connectors.item(1)

'コネクタの中心

connectorX = connector.left + connector.Width / 2

connectorY = connector.top + connector.Height / 2

Set kaitenConnector = kaiten2(centerX, centerY, connectorX, connectorY, -theta2)

reverseDX = kaitenConnector("x") - connectorX

reverseDY = kaitenConnector("y") - connectorY

End If

kaitenTree Nothing, svc, -theta2

treeMoveBy svc, -reverseDX, -reverseDY

End Sub

''関数 23 / 52

Sub treeMoveBy(targetSvc As Shape, x As Double, y As Double)

'treeMoveByは現在、プログラム中１か所から呼ばれている。（ツリーを考慮した回転０°）

targetSvc.left = targetSvc.left + x

targetSvc.top = targetSvc.top + y

Dim connectors As Collection

Set connectors = searchConnectorsOnArm(targetSvc, True) '6

Dim connector As Shape

For Each connector In connectors

connector.left = connector.left + x

connector.top = connector.top + y

Dim pair As Collection

Set pair = connectorName2arms(connector.name)

treeMoveBy pair("child"), x, y

Next connector

End Sub

'３段階の回転

'kaitenTree ツリー構造全体を回転

'kaitenShape shapeを回転

'kaiten2 座標を回転

'コネクタを中心に、targetSvcを回転する。連なる子も回転する。

''関数 24 / 52

Sub kaitenTree(centerSvc As Shape, targetSvc As Shape, theta2 As Double)

'kaitenTreeは現在、プログラム中１か所から呼ばれている。（ツリーを考慮した回転０°）

'centerSvcはその一か所でNothingが指定されている。

'自身の回転処理

If centerSvc Is Nothing Then

Set centerSvc = targetSvc

End If

kaitenShape centerSvc, targetSvc, theta2

'子の回転処理

Dim connectors As Collection

Set connectors = searchConnectorsOnArm(targetSvc, True) '7

Dim connector As Shape

For Each connector In connectors

'コネクタを回転

kaitenShape centerSvc, connector, theta2

'コネクタ以降のツリーを回転

Dim pair As Collection

Set pair = connectorName2arms(connector.name)

kaitenTree centerSvc, pair("child"), theta2

Next connector

End Sub

'kaiten2のshape対応版

''関数 25 / 52

Sub kaitenShape(centerShape As Shape, targetShape As Shape, theta2 As Double)

Dim cx As Double

Dim cy As Double

Dim x As Double

Dim y As Double

'中心点と、回転対象座標を得る

cx = centerShape.left + centerShape.Width / 2

cy = centerShape.top + centerShape.Height / 2

x = targetShape.left + targetShape.Width / 2

y = targetShape.top + targetShape.Height / 2

'回転する

Dim result As Collection

Set result = kaiten2(cx, cy, x, y, theta2)

'回転値をshapeに反映

targetShape.left = result("x") - targetShape.Width / 2

targetShape.top = result("y") - targetShape.Height / 2

targetShape.Rotation = targetShape.Rotation + WorksheetFunction.Degrees(theta2)

End Sub

''関数 26 / 52

Function kaiten2(ByVal cx As Double, ByVal cy As Double, ByVal x As Double, ByVal y As Double, ByVal theta2 As Double) As Collection

x = x - cx

y = y - cy

Dim theta1 As Double

Dim hankei As Double

If x = 0 And y = 0 Then

theta1 = 0

Else

theta1 = WorksheetFunction.Atan2(x, y)

End If

hankei = Sqr(x * x + y * y)

Set kaiten2 = New Collection

kaiten2.add Cos(theta1 + theta2) * hankei + cx, "x"

kaiten2.add Sin(theta1 + theta2) * hankei + cy, "y"

End Function

'名前維持してグループ解除

''関数 27 / 52

Private Sub ribbon9(ribbonControl As IRibbonControl) 'ButtonUngroup_click

'すべての図形の名前リスト

Dim shapesList As String

shapesList = ","

Dim theShape As Shape

For Each theShape In acShapes

shapesList = shapesList & theShape.name & ","

Next theShape

'グループの名前

Dim theName As String

theName = Selection.ShapeRange.name

'グループ解除

Selection.ShapeRange.Ungroup

Dim first As Boolean

first = True

Dim processed As Boolean

processed = False

For Each theShape In acShapes

'グループ解除で新たに表れた図形であるか

If Not shapesList Like "*," & theShape.name & ",*" Then

'名前が過去にグループ化されたSVCであるときは

If theShape.name Like "old_" & theName Then

'その名前を元に戻す

theShape.name = theName

processed = True

End If

'グループ解除したものをすべて選択状態にする

If first Then

theShape.Select

first = False

Else

theShape.Select False

End If

End If

Next theShape

'グループ解除を取り消し

If Not processed Then

Selection.ShapeRange.Group.Select

Selection.name = theName

alert "グループ解除はしませんでした", "「old_*」という名前の子に名前を引き継がせたいが、いないため。"

End If

End Sub

'名前を維持してグループ化

''関数 28 / 52

Private Sub ribbon8(ribbonControl As IRibbonControl) 'ButtonGroup_Click

Dim allSvcs As Collection

Set allSvcs = getAllSvcs

'複数選択のうちSVCであるものをリストアップ

Dim selectedSvcs As Collection

Set selectedSvcs = New Collection

Dim theShape As Shape

For Each theShape In Selection.ShapeRange

If Not Collection_indexOf(allSvcs, theShape) = -1 Then

selectedSvcs.add theShape

End If

Next theShape

'複数選択のうちSVCであるものが１つであるとき

If selectedSvcs.Count = 1 Then

'名前を維持してグループ化

Dim theName As String

theName = selectedSvcs.item(1).name

selectedSvcs.item(1).name = "old_" & selectedSvcs.item(1).name

Selection.ShapeRange.Group.Select

Selection.name = theName

alert "名前を維持してグループ化しました", "", rgbBlack

Else

'複数選択のうちSVCがない、またはSVCが２個以上のとき

'通常のグループ化

Selection.ShapeRange.Group.Select

alert "通常のグループ化をしました", "", rgbBlack

End If

End Sub

''関数 29 / 52

Private Function Collection_indexOf(theCollection As Collection, target As Object) As Integer

Dim theItem As Object

Dim idx As Integer

idx = 0

For Each theItem In theCollection

idx = idx + 1

If theItem Is target Then

Collection_indexOf = idx

Exit Function

End If

Next theItem

Collection_indexOf = -1

End Function

'新規コネクタ

''関数 30 / 52

Private Sub ribbon7(ribbonControl As IRibbonControl) 'ButtonNewConnectorAt_Click

'check

If selectionIsError(False, True, False) Then Exit Sub

makeConnector Selection.ShapeRange.item(1)

End Sub

''関数 31 / 52

Private Function makeConnector(arm As Shape, Optional typeIsAfter As Boolean = True) As Shape

Dim connectorName As String

If typeIsAfter Then

connectorName = arm.name & ">"

Else

connectorName = ">" & arm.name

End If

'check. すでにある

If Collection_existsByName(acShapes, connectorName) Then

acShapes(connectorName).Select

Exit Function

End If

Dim centerX As Integer

centerX = arm.left + arm.Width / 2

Dim centerY As Integer

centerY = arm.top + arm.Height / 2

Dim connector As Shape

Set connector = getAllConnectors.item(1)

connector.Copy

ActiveSheet.Paste

Selection.name = connectorName

Set makeConnector = acShapes(Selection.name)

makeConnector.left = centerX - connector.Width / 2

makeConnector.top = centerY - connector.Height / 2

End Function

''関数 32 / 52

Public Function Collection_existsByName(theCollection As Object, keyName As String) As Boolean

Dim theShape As Shape

For Each theShape In theCollection

If theShape.name Like keyName Then

Collection_existsByName = True

Exit Function

End If

Next theShape

Collection_existsByName = False

End Function

''関数 33 / 52

Private Sub ribbon6(ribbonControl As IRibbonControl) 'ButtonSelectorWindow_Click

userform3.Show 0

userform3.left = Application.Width - userform3.Width - 32

userform3.top = Application.Height / 2 - userform3.Height / 2

End Sub

'ボタン　コネクタの表示非表示

''関数 34 / 52

Private Sub ribbon5(ribbonControl As IRibbonControl, pressed As Boolean) 'ButtonToggleConnectorVisiblity_Click

sw_connectorVisible = Not sw_connectorVisible

updateConnectorVisible

End Sub

'以降を選択

''関数 35 / 52

Private Sub ribbon4(ribbonControl As IRibbonControl) 'CommandButton_順_Click

'check

If selectionIsError(False, True, False) Then Exit Sub

Dim targetSvc As Shape

Set targetSvc = ActiveSheet.Shapes(Selection.name)

Dim svcs As Collection

Set svcs = getSvcsAfter(targetSvc)

Dim svc As Shape

For Each svc In svcs

svc.Select Replace:=False

Next svc

End Sub

'以前を選択

''関数 36 / 52

Private Sub ribbon3(ribbonControl As IRibbonControl) 'CommandButton_逆_Click

'check

If selectionIsError(False, True, False) Then Exit Sub

Dim targetSvc As Shape

Set targetSvc = ActiveSheet.Shapes(Selection.name)

Dim svcs As Collection

Set svcs = getSvcsBefore(targetSvc)

Dim svc As Shape

For Each svc In svcs

svc.Select Replace:=False

Next svc

End Sub

''関数 37 / 52

Public Function selectionIsError(zeroSelOK, oneSelOK, multiSelOK, Optional multiselmax As Integer = -1)

'選択状態が正しい時、falseを返す。

If Not zeroSelOK And TypeName(Selection) = "Range" Then

alert "何も選択されていません", "何か図形を選択してください"

selectionIsError = True

Exit Function

ElseIf Not multiSelOK And Selection.ShapeRange.Count > 1 Then

alert "この機能は単数選択のみです", "選択を１つにしてください"

selectionIsError = True

Exit Function

ElseIf multiSelOK And Selection.ShapeRange.Count > multiselmax Then

alert "この機能は複数選択可能ですが、選択は " & multiselmax & " 個までです。", "選択数を減らして下さい"

selectionIsError = True

Exit Function

End If

selectionIsError = False

End Function

''関数 38 / 52

Sub alert(messstr As String, Optional waystr As String = "", Optional messcol As OLE_COLOR = rgbRed, Optional waycol As OLE_COLOR = rgbGreen)

'check.

If Not Collection_existsByName(acShapes, "shapeEX_alert") Then

'アラート表示を作成

With ActiveSheet.Shapes.AddShape( _

Type:=msoShapeRectangle, _

left:=100, top:=100, Width:=200, Height:=125 _

)

.name = "shapeEX_alert"

.line.ForeColor.RGB = rgbBlack '枠線の色

.Fill.ForeColor.RGB = rgbLightSalmon '塗りつぶし色

.TextFrame2.WordWrap = True '右端で自動改行する

.OnAction = "alert_click"

End With

End If

Dim shapeEX_alert As Shape

Set shapeEX_alert = acShapes("shapeEX_alert")

With shapeEX_alert.TextFrame.Characters

.text = "ShapeEX メッセージ：" & vbCrLf & vbCrLf

.text = .text & messstr & vbCrLf

If Not waystr = "" Then

.text = .text & "→ " & waystr & vbCrLf

End If

.text = .text & vbCrLf & vbCrLf & "クリックするとメッセージを消します"

.Font.Color = messcol

End With

End Sub

''関数 39 / 52

Sub alert_click()

acShapes("shapeEX_alert").Delete

End Sub

'以前を取得

''関数 40 / 52

Private Function getSvcsBefore(targetSvc As Shape, Optional connectorHistory As String = "") As Collection

Set getSvcsBefore = New Collection

getSvcsBefore.add targetSvc

Dim connectors As Collection

Dim connector As Shape

Dim pair As Collection

'順　※初回はスキップ

If Not connectorHistory = "" Then

Set connectors = searchConnectorsOnArm(targetSvc, True) '3

'check

If connectors.Count = 0 Then Exit Function

For Each connector In connectors

'check 未処理コネクタである

If Not connectorHistory Like "*[[]" & connector.name & "]*" Then

connectorHistory = connectorHistory & "[" & connector.name & "]"

Set pair = connectorName2arms(connector.name)

getSvcsBefore.add connector

'順

Collection_concat getSvcsBefore, getSvcsAfter(pair("child"))

End If

Next connector

End If

'逆

Set connectors = searchConnectorsOnArm(targetSvc, False) '4

'check　その方向のコネクタなし？

If connectors.Count = 0 Then Exit Function

For Each connector In connectors

'check 未処理コネクタである

If Not connectorHistory Like "*[[]" & connector.name & "]*" Then

connectorHistory = connectorHistory & "[" & connector.name & "]"

Set pair = connectorName2arms(connector.name)

getSvcsBefore.add connector

Collection_concat getSvcsBefore, getSvcsBefore(pair("parent"), connectorHistory)

End If

Next connector

End Function

''関数 41 / 52

Private Sub Collection_concat(c1 As Collection, c2 As Collection)

Dim theShape As Shape

For Each theShape In c2

c1.add theShape

Next theShape

End Sub

'以降を取得

''関数 42 / 52

Public Function getSvcsAfter(targetSvc As Shape) As Collection

'仕様

'コネクタを頼りに走査するので、結果はツリー順に並ぶ。

Dim pair As Collection

Set getSvcsAfter = New Collection

'check.

If targetSvc Is Nothing Then Exit Function

getSvcsAfter.add targetSvc

If targetSvc.name Like "*>*" Then

'targetSvcがコネクタの場合

Set pair = connectorName2arms(targetSvc.name)

Collection_concat getSvcsAfter, getSvcsAfter(pair("child"))

Else

'targetShapeがコネクタではない場合

Dim connectors As Collection

Set connectors = searchConnectorsOnArm(targetSvc, True) '2

'check　コネクタがない

If connectors.Count = 0 Then Exit Function

Dim connector As Shape

For Each connector In connectors

getSvcsAfter.add connector

Set pair = connectorName2arms(connector.name)

Collection_concat getSvcsAfter, getSvcsAfter(pair("child"))

Next connector

End If

End Function

'その図形が持つコネクタを得る

''関数 43 / 52

Function searchConnectorsOnArm(targetArm As Shape, order As Boolean) As Collection '8

Dim nameKey As String

If order Then

nameKey = targetArm.name & ">*"

Else

nameKey = "*>" & targetArm.name

End If

'変更　未検証

Set searchConnectorsOnArm = searchShapesByKey(nameKey)

' Dim theShape As Shape

' For Each theShape In acShapes

' If theShape.name Like keyName Then

' 'targetShapeが親になっているコネクタを見つけたら

' searchConnectorsOnArm.add theShape

' End If

' Next theShape

End Function

'コネクタをすべて選択

''関数 44 / 52

Public Sub ButtonSelectConnectors_Click(ribbonControl As IRibbonControl)

sw_connectorVisible = True

updateConnectorVisible

Range("A1").Select '選択解除

Dim theShape As Shape

For Each theShape In acShapes

If theShape.name Like "*>*" Then

theShape.Select Replace:=False

End If

Next theShape

End Sub

'コネクタの表示非表示

''関数 45 / 52

Private Sub updateConnectorVisible()

Dim theShape As Shape

For Each theShape In acShapes

If theShape.name Like "*>*" Then

theShape.Visible = sw_connectorVisible

theShape.ZOrder msoBringForward '最前面にする

End If

Next theShape

End Sub

'-o

'すべてを選択

''関数 46 / 52

Public Sub ButtonSelectAll_Click(ribbonControl As IRibbonControl)

Dim allSvcs As Collection

Set allSvcs = getAllSvcs()

Dim first As Boolean

first = True

Dim svc As Shape

For Each svc In allSvcs

If first Then

svc.Select

first = False

Else

svc.Select Replace:=False

End If

Next svc

End Sub

'-o

'すべてのアームとコネクタを取得

''関数 47 / 52

Private Function getAllSvcs() As Collection

Set getAllSvcs = searchUTL(True, True)

End Function

'-o

'すべてのアームを取得

''関数 48 / 52

Private Function getAllArms() As Collection

Set getAllArms = searchUTL(True, False)

End Function

'-o

'すべてのコネクタを取得

''関数 49 / 52

Private Function getAllConnectors() As Collection

Set getAllConnectors = searchUTL(False, True)

End Function

'-o

''関数 50 / 52

Private Function searchUTL(armsFLG As Boolean, connectorsFLG As Boolean) As Collection

'仕様

'ツリー順ではない

'check.

If Not armsFLG And Not connectorsFLG Then

MsgBox "searchUTLの引数が両方ともfalseなのは想定外"

Exit Function

End If

'コネクタをすべて取得

Dim connectors As Collection

Set connectors = searchShapesByKey("*>*")

'check.

If (Not armsFLG) And connectorsFLG Then

Set searchUTL = connectors

Exit Function

End If

'コネクタに連なる組をそれぞれ取得

Set searchUTL = New Collection

Dim connector As Shape

For Each connector In connectors

Dim pair As Collection

Set pair = connectorName2arms(connector.name)

If connectorsFLG Then searchUTL.add connector

If Not pair("parent") Is Nothing Then searchUTL.add pair("parent")

If Not pair("child") Is Nothing Then searchUTL.add pair("child")

Next connector

End Function

'-o

'検索キーに適合する名前を持つ図形を検索する

''関数 51 / 52

Private Function searchShapesByKey(nameKey As String) As Collection

Set searchShapesByKey = New Collection

Dim theShape As Shape

For Each theShape In acShapes

If theShape.name Like nameKey Then

searchShapesByKey.add theShape

End If

Next theShape

End Function

'-o

'コネクタの名前に記載された２つのarmを返す

''関数 52 / 52

Function connectorName2arms(connectorName As String) As Collection

'コネクタの名前を分割

Dim tokens() As String

tokens = Split(connectorName, ">")

Set connectorName2arms = New Collection

If tokens(0) = "" Then

connectorName2arms.add Nothing, "parent"

ElseIf Collection_existsByName(acShapes, tokens(0)) Then

connectorName2arms.add ActiveSheet.Shapes(tokens(0)), "parent"

Else

connectorName2arms.add Nothing, "parent"

End If

If tokens(1) = "" Then

connectorName2arms.add Nothing, "child"

ElseIf Collection_existsByName(acShapes, tokens(1)) Then

connectorName2arms.add ActiveSheet.Shapes(tokens(1)), "child"

Else

connectorName2arms.add Nothing, "child"

End If

End Function

2018/12/1（土）

今月の冒頭JavaScript

JavaScriptはお休みにして、Excelで作成しているSVC（Side View Character）のツールで作成した「画像」（剣を持っている女性）をちょっと載せています。